home *** CD-ROM | disk | FTP | other *** search
/ ETO Development Tools 2 / ETO Development Tools 2.iso / Tools - Objects / MacsBug / MacsBug 6.1 / dcmds / Pascal Samples / Heap.p < prev    next >
Encoding:
Text File  |  1989-04-21  |  2.1 KB  |  88 lines  |  [TEXT/MPS ]
  1. UNIT Heap;
  2.  
  3. (* The following MPW commands will build the dcmd and copy it to the
  4.    "Debugger Prefs" file in the System folder. The dcmd's name in
  5.          MacsBug will be the name of the file built by the Linker.
  6.  
  7.         Pascal Heap.p
  8.         Link dcmdGlue.a.o Heap.p.o {Libraries}Runtime.o {PLibraries}PasLib.o -o Heap
  9.         BuildDcmd Heap 100
  10. *)
  11.  
  12. {$R-}
  13.  
  14. INTERFACE
  15.  
  16.         USES MemTypes, dcmd;
  17.         
  18.   { Public declaration for dcmdGlue. Must be in every dcmd. The name cannot be changed. }
  19.         PROCEDURE CommandEntry (paramPtr: dcmdBlockPtr);
  20.  
  21.  
  22. IMPLEMENTATION
  23.  
  24. PROCEDURE NumberToHex (number: LONGINT; VAR hex: Str255);
  25. VAR digits: Str255;
  26.     n: INTEGER;
  27. BEGIN
  28.   digits := '0123456789ABCDEF';
  29.         hex    := '00000000';
  30.         FOR n := 8 DOWNTO 1 DO
  31.           BEGIN
  32.                 hex[n] := digits[1 + (number MOD 16)];
  33.                 number := number DIV 16;
  34.                 END;
  35. END;
  36.  
  37.  
  38. PROCEDURE DisplayBlockInfo (blockAddress, blockLength, masterPtr: LONGINT; blockType: INTEGER; locked, purgeable, resource: BOOLEAN);
  39. VAR value: Str255;
  40. BEGIN
  41.         NumberToHex (blockAddress, value);
  42.         dcmdDrawLine (value);
  43.  
  44.         NumberToHex (blockLength, value);
  45.         dcmdDrawString (' ');
  46.         dcmdDrawString (value);
  47.  
  48.         IF blockType = relocatableBlock THEN
  49.           BEGIN
  50.                 NumberToHex (masterPtr, value);
  51.                 dcmdDrawString (' ');
  52.                 dcmdDrawString (value);
  53.  
  54.                 dcmdDrawString (' ');
  55.                 IF locked THEN
  56.                         dcmdDrawString ('Locked ');
  57.                 IF purgeable THEN
  58.                         dcmdDrawString ('Purgeable ');
  59.                 IF resource THEN
  60.                         dcmdDrawString ('Resource ');
  61.                 END;
  62. END;
  63.  
  64.  
  65. PROCEDURE CommandEntry (paramPtr: DCmdBlockPtr);
  66. BEGIN
  67.   IF paramPtr^.request = dcmdInit THEN
  68.           BEGIN    { The dcmd gets called once when loaded to init itself }
  69.                 END
  70.         ELSE
  71.   IF paramPtr^.request = dcmdDoIt THEN
  72.           BEGIN { Do the command's normal function }
  73.                 { Draw the column labels }
  74.                 dcmdDrawLine ('  Address   Length  Mstr Ptr');
  75.  
  76.     { The MacsBug heap iterator will call DisplayBlockInfo once for each block in the heap }
  77.                 dcmdForAllHeapBlocks (@DisplayBlockInfo);
  78.                 END
  79.         ELSE
  80.   IF paramPtr^.request = dcmdHelp THEN
  81.           BEGIN { Display the command's help information }
  82.                 dcmdDrawLine ('HEAP');
  83.                 dcmdDrawLine ('   Displays information about all heap blocks');
  84.                 END;
  85. END;
  86.  
  87. END.
  88.